home *** CD-ROM | disk | FTP | other *** search
/ Mac Format 1995 June / MacFormat 25.iso / Shareware City / Developers / ICProgKit1.0 / Source / Libs / ICMappings.p < prev    next >
Text File  |  1994-12-03  |  5KB  |  181 lines
  1. unit ICMappings;
  2.  
  3. interface
  4.  
  5.     uses
  6. {$ifc undefined THINK_Pascal}
  7.         Types, Files, Aliases, Errors, 
  8. {$endc}
  9.         ICTypes, ICAPI, ICKeys;
  10.  
  11.     function ICMCountEntries (entries: Handle; var count: longint): ICError;
  12.     function ICMGetEntry (entries: handle; pos: longInt; var entry: ICMapEntry): ICError;
  13.     function ICMGetIndEntry (entries: handle; ndx: longint; var pos: longint; var entry: ICMapEntry): ICError;
  14.     function ICMAddEntry (entries: handle; var entry: ICMapEntry): ICError;
  15.     function ICMDeleteEntry (entries: handle; pos: longint): ICError;
  16.     function ICMSetEntry (entries: handle; pos: longInt; var entry: ICMapEntry): ICError;
  17.  
  18. implementation
  19.  
  20. {$ifc undefined THINK_Pascal}
  21.     uses
  22.         Memory, ToolUtils;
  23. {$endc}
  24.  
  25.     function UnpackEntry (entries: handle; pos: longInt; var entry: ICMapEntry; var user_length: longInt): OSErr;
  26. (* WARNING: Depends very much on the exact format of ICMapEntry! *)
  27.         procedure CopyString (var p: ptr; var s: str255);
  28.             var
  29.                 len: integer;
  30.         begin
  31.             len := BAND(p^, $FF) + 1;
  32.             BlockMove(p, @s, len);
  33.             p := ptr(ord(p) + len);
  34.         end;
  35.         var
  36.             org: Ptr;
  37.             p: ptr;
  38.             maxsize: longInt;
  39.             err: OSErr;
  40.     begin
  41.         err := noErr;
  42.         if (entries = nil) | (entries^ = nil) | (pos < 0) | (pos > GetHandleSize(entries) - 6) then begin
  43.             err := paramErr;
  44.         end;
  45.         if err = noErr then begin
  46.             p := (ptr(ord(entries^) + pos));
  47.             maxsize := GetHandleSize(entries);
  48.             org := p;
  49.             BlockMove(p, @entry, 6);
  50.             if (entry.fixed_length <> ICmap_fixed_length) | (entry.fixed_length > entry.total_length) | (entry.total_length > maxsize) then begin
  51.                 err := badExtResource;
  52.             end;
  53.         end;
  54.         if err = noErr then begin
  55.             BlockMove(p, @entry, entry.fixed_length);
  56.             p := ptr(ord(p) + entry.fixed_length);
  57.             CopyString(p, entry.extension);
  58.             CopyString(p, entry.creator_app_name);
  59.             CopyString(p, entry.post_app_name);
  60.             CopyString(p, entry.MIME_type);
  61.             CopyString(p, entry.entry_name);
  62.             user_length := entry.total_length - (ord(p) - ord(org));
  63.         end;
  64.         UnpackEntry := err;
  65.     end;
  66.  
  67.     procedure PackEntry (var entry: ICMapEntry; p: ptr; user_length: longInt);
  68.         procedure CopyString (var s: str255);
  69.         begin
  70.             BlockMove(@s, ptr(ord(p) + entry.total_length), length(s) + 1);
  71.             entry.total_length := entry.total_length + length(s) + 1;
  72.         end;
  73.     begin
  74.         entry.version := 0;
  75.         entry.fixed_length := ord(@entry.extension) - ord(@entry);
  76.         entry.total_length := entry.fixed_length;
  77.         CopyString(entry.extension);
  78.         CopyString(entry.creator_app_name);
  79.         CopyString(entry.post_app_name);
  80.         CopyString(entry.MIME_type);
  81.         CopyString(entry.entry_name);
  82.         entry.total_length := entry.total_length + user_length;
  83.         BlockMove(@entry, p, entry.fixed_length);
  84.     end;
  85.  
  86.     function ICMDeleteEntry (entries: handle; pos: longint): ICError;
  87.         var
  88.             entry: ICMapEntry;
  89.             junk: longint;
  90.             user_length: longInt;
  91.             err: OSErr;
  92.     begin
  93.         err := UnpackEntry(entries, pos, entry, user_length);
  94.         if err = noErr then begin
  95.             junk := Munger(entries, pos, nil, entry.total_length, Ptr(-1), 0);
  96.             err := MemError;
  97.         end;
  98.         ICMDeleteEntry := err;
  99.     end; (* ICMDeleteEntry *)
  100.  
  101.     function GetShort (p: Ptr): integer;
  102.     begin
  103.         GetShort := BAND(p^, $FF) * 256 + BAND(ptr(ord(p) + 1)^, $FF);
  104.     end;
  105.  
  106.     function ICMCountEntries (entries: Handle; var count: longint): ICError;
  107.         var
  108.             p: Ptr;
  109.             pos: longint;
  110.             size: integer;
  111.     begin
  112.         p := entries^;
  113.         pos := 0;
  114.         count := 0;
  115.         while pos < GetHandleSize(entries) do begin
  116.             size := GetShort(p);
  117.             pos := pos + size;
  118.             p := ptr(ord(p) + size);
  119.             count := count + 1;
  120.         end; (* while *)
  121.         ICMCountEntries := noErr;
  122.     end; (* ICMCountEntries *)
  123.  
  124.     function ICMGetEntry (entries: handle; pos: longInt; var entry: ICMapEntry): ICError;
  125.         var
  126.             user_length: longInt;
  127.     begin
  128.         ICMGetEntry := UnpackEntry(entries, pos, entry, user_length);
  129.     end;
  130.  
  131.     function ICMGetIndEntry (entries: handle; ndx: longint; var pos: longint; var entry: ICMapEntry): ICError;
  132.         var
  133.             err: ICError;
  134.             p: Ptr;
  135.             i: longint;
  136.             size: integer;
  137.     begin
  138.         p := entries^;
  139.         pos := 0;
  140.         while (ndx > 1) & (pos < GetHandleSize(entries)) do begin
  141.             size := GetShort(p);
  142.             pos := pos + size;
  143.             p := Ptr(ord(p) + size);
  144.             ndx := ndx - 1;
  145.         end; (* while *)
  146.         ICMGetIndEntry := ICMGetEntry(entries, pos, entry);
  147.     end; (* ICMGetIndEntry *)
  148.  
  149.     function ICMAddEntry (entries: handle; var entry: ICMapEntry): ICError;
  150.         var
  151.             e: ICMapEntry;
  152.     begin
  153.         PackEntry(entry, @e, 0);
  154.         ICMAddEntry := PtrAndHand(@e, entries, entry.total_length);
  155.     end;
  156.  
  157.     function ICMSetEntry (entries: handle; pos: longInt; var entry: ICMapEntry): ICError;
  158.         var
  159.             err: ICError;
  160.             e: ICMapEntry;
  161.             oldentry: ICMapEntry;
  162.             user_length: longInt;
  163.             source_length: longInt;
  164.             junk: longInt;
  165.     begin
  166.         err := UnpackEntry(entries, pos, oldentry, user_length);
  167.         if err = noErr then begin
  168.             PackEntry(entry, @e, user_length);
  169.             source_length := oldentry.total_length - user_length;
  170.             if user_length < 8 then begin { hack to remove alignment bytes from previous version }
  171.                 source_length := oldentry.total_length;
  172.                 e.total_length := e.total_length - user_length;
  173.                 user_length := 0;
  174.             end;
  175.             junk := Munger(entries, pos, nil, source_length, @e, e.total_length - user_length);
  176.             err := MemError;
  177.         end;
  178.         ICMSetEntry := err;
  179.     end;
  180.  
  181. end. (* ICMappings *)